
# graph.pm  Version 1.0  October 2005
#
# routines for working with graphs in Perl (under unix) as I do them.
#
# WARNING: these codes have not been "blooded" - they are a codification
#          of what I have been doing disparately for some time, and in 
#          any case the usual disclaimer applies (see below).
#
# 1. Getting started
# ===================
#
# First: might be worth looking at: 
#
#        http://www.clarkFrancis.com/docs/graphs_in_Perl.html
#
# Second: -After- having a look at the function 
#        "validate_node_and_edge_operations",
# Write a 4 line script:
#
#     #!/usr/bin/perl -w
#     unshift @INC, "$ENV{'HOME'}/perl/modules/";   # change as appropriate
#     require graph;
#     graph::validate_node_and_edge_operations();
#
# and do some iterations.
#
# Third: -After- having a quick look at, in particular the comments 
#        for "subgraphs" (~line 335), and the comments above the function 
# "make_random", (~line 265), set up a script like:
#
#     #!/usr/bin/perl -w
#     unshift @INC, "$ENV{'HOME'}/perl/modules/";   # change as appropriate
#     require graph;
#     $g = graph::make_random( 20, 10 );
#     graph::print_details( $g );
#     $ra_csg = graph::get_csg_all( $g );
#     foreach $csg (@$ra_csg)
#     {
#         $sg = graph::make_graph_from_csg_list( $g, $csg );
#         graph::print_details( $sg );
#     }
#
# and run a few times; modifying the parameters to make_random as much
# as you like.
#
#
# 2. Functions list
# =================
# 
#               validate_node_and_edge_operations()
#               print_details( $g )
#  ($Ne, $Nc) = node_and_edge_counts( $g )
#          $g = create();
#               destroy( $g );
#               add_node( $g, $n );                add node
#               sub_node( $g, $n );           subtract node
#               add_edge( $g, $n1, $n2 );          add edge
#               sub_edge( $g, $n1, $n2 );     subtract edge
# 
#               make_random( $num_nodes, $num_edges_ask );
#                
#         $rh = get_csg_around_node( $g, $n );       returns a hash table of the nodes
#         $ra = get_csg_all( $g );                   returns an array of the above
#         $sg = make_graph_from_csg_list( $g, $rh );
#
#
# 3. Other Notes
# ==============
#
# As with most things, pulling this together was like the old lady who
# swallowed the fly: the main task was to get into one place the functions 
# for dissecting a graph into its connected components. And I have also wanted
# for some time to write a little web page on how to do graphs in Perl. I've
# tried to make it all a coherent whole, and, as always, welcome feedback. 
#
# I am notoriously bad and finding and using other peoples code, and I suppose
# that others have built all sorts for doing graphs in Perl. If you know of
# such, please drop me a line to let me know - if only so I can include pointers
# to this.
#
#
# 4. Disclaimer
# =============
#
#   =======================================================================
#   DISCLAIMER: This script is made available in the hope that it might be
#               useful, but, without any guarantee or warranty of any sort.
#               Examine, understand, validate and debug/modify it to your 
#               own satisfaction for any purpose that you might use it.
#   =======================================================================
#
#
# Francis Clark, 
# October 2005,
# www.clarkfrancis.com


package graph;



#====
# Once this is called, press return for next iteration, and EOF (^D) to finish.
# Chooses nodes randomly from 1 to 9, and in each iteration adds an edge and 
# subtracts an edge, and adds a node and subtracts a node. Codes should cope 
# with adding new nodes, and subtracting non-existent nodes.

sub validate_node_and_edge_operations
{
    my( $n1, $n2, $n3, $n4 );
    
    my $g = create();
    print_details();

    do
    {
        $n1 = 1 + int( rand( 9 ));  $n2 = 1 + int( rand( 9 ));  # edge to add
        $n3 = 1 + int( rand( 9 ));  $n4 = 1 + int( rand( 9 ));  # edge to remove
        
        print "edges: + $n1-$n2,  - $n3-$n4\n";
        
        add_edge( $g, $n1, $n2 );
        sub_edge( $g, $n3, $n4 );
        
        $n1 = 1 + int( rand( 9 ));   # node to add
        $n2 = 1 + int( rand( 9 ));   # node to remove
        
        print "nodes: + $n1,  - $n2\n";
        
        add_node( $g, $n1 );
        sub_node( $g, $n2 );
        
        print_details( $g );
    }
    while( <STDIN> );  # that is, use ^D to finish.

    destroy( $g );
    print_details( $g );
}


#====
# Print out details of a graph on a node by node basis
# This was written for validation purposes

sub print_details
{
    my( $g ) = @_;
    
    my( $n );
    my @nodes = sort keys %$g;
    my @neigh;
    my( $num_nodes, $num_edges ) = node_and_edge_counts( $g );

    print "\n";
    print "== graph details ==\n";
    print "There are $num_nodes nodes, and $num_edges edges\n";
    foreach $n (@nodes)
    {
        @neigh = sort keys %{$g->{$n}};
        print "$n : @neigh\n";
    }
    print "===================\n";
    print "\n";
}


#====
# NOTE that this only half counts edges that connect a node to itself

sub node_and_edge_counts
{
    my( $g ) = @_;
    
    my( $num_nodes, $num_edges, $n );
    my @nodes = keys %$g;
    
    $num_nodes = @nodes;
    $num_edges = 0;
    
    foreach $n (@nodes)
    { 
        $num_edges += keys %{$g->{$n}};
    }
    $num_edges /= 2;
    
    return( $num_nodes, $num_edges );
}



sub create
{
    my $g = {};
    return( $g );
}


#====
# I don't have a detailed understanding of how Perl manages the
# freeing of memory / garbage collection. For practical purposes
# the following does the trick (and I assume garbage collection
# picks up the rest)

sub destroy
{
    my( $g ) = @_;
    my( $n );
    my @nodes = keys %$g;
    
    foreach $n (@nodes) { delete $g->{$n}; }
}


#====
# In general I add nodes implicitly by adding edges, but if
# edge-less nodes are allowed, then need to add nodes explicitly

sub add_node
{
    my( $g, $n ) = @_;
    
    $g->{$n} = {}  if( not exists $g->{$n} );
}


sub sub_node
{
    my( $g, $n1 ) = @_;
    
    my( $n2 );
    my @neigh;
    
    if( not exists $g->{$n1} ) { return; }
    
    @neigh = keys %{$g->{$n1}};
    foreach $n2 (@neigh) { sub_edge( $g, $n1, $n2); }
    
    delete $g->{$n1};
}


sub add_edge
{
    my( $g, $n1, $n2 ) = @_;

    $g->{$n1}->{$n2} = $g->{$n2}->{$n1} = 1;
}


sub sub_edge
{
    my( $g, $n1, $n2 ) = @_;
    
    if( exists $g->{$n1}  and  exists $g->{$n1}->{$n2} ) { delete $g->{$n1}->{$n2}; }
    if( exists $g->{$n2}  and  exists $g->{$n2}->{$n1} ) { delete $g->{$n2}->{$n1}; }
}


#==================================================

#====

# To generate a "random" graph with the specified node and edge counts
# (and subject to the conditions, as here, that there are no singleton
# nodes and no self-connected nodes) would require the equivalent of
# enumerating all such graphs and randomly selecting one. This is not
# what happens here, so what I mean here by "random" is random enough
# for what I need - which is usually just a graph to kick around to
# test or understand something.
#
# In particular, the requested number of edges is not necessarily 
# what you get, but a lower bound - that's just the way the cookie
# crumbles sometimes.
# 
# What this function does is to construct a fully connected graph 
# with the specified number of nodes, and then to remove edges, subject 
# to the constraint of having no singleton nodes, until either the 
# specified edge count is reached, or there are no more edges available 
# for removal.
# 
# I haven't thought particularly about what happens if you ask for
# a graph with a very large number of nodes.

sub make_random
{
    my( $num_nodes, $num_edges_ask ) = @_;
    
    my( $max_edges, $i, $j, $num_edges_have, $g );
    my( %edges, @egs, $e, $n1, $n2 );
    
    # checks
    if( 2 > $num_nodes                  ) { $num_nodes = 2;                             warn "WARNING [graph::make_random] setting num_nodes = 2\n"; }
    if( $num_nodes / 2 > $num_edges_ask ) { $num_edges_ask = int( (1 + $num_nodes)/2 ); warn "WARNING [graph::make_random] setting num_edges = $num_edges_ask\n"; }
    $max_edges = $num_nodes * ($num_nodes - 1);
    if( $num_edges_ask > $max_edges     ) { $num_edges_ask = $max_edges;                warn "WARNING [graph::make_random] setting num_edges = $num_edges_ask\n"; }

    # the simplest way to do this seems to be to start with the complete graph
    # and then knock out edges until the required number is reached (if pos)
    
    $g = {};  $num_edges_have = 0;
    
    for( $i=1; $i<=$num_nodes; $i++ )
    {
        for( $j=$i+1; $j<=$num_nodes; $j++ )
        {
            $g->{$i}->{$j} = $g->{$j}->{$i} = 1;  $num_edges_have++;
            $edges{"$i:$j"} = 1;
        }
    }
    
    while( $num_edges_have > $num_edges_ask )     # now remove edges as required
    {
        @egs = keys %edges;
        if( 0 == @egs ) { last; }
        $e   = $egs[ int( rand( @egs )) ];
        $e  =~ /(\d+):(\d+)/  or die "ERROR [graph::make_random] with decoding key: $e\n";
        $n1 = $1;  $n2 = $2;
        
        delete $edges{$e};  # only try a given edge once 
        
        if( 1 < keys %{$g->{$n1}}  and  1 < keys %{$g->{$n2}} )        # this edge can be removed
        {
            delete $g->{$n1}->{$n2};  delete $g->{$n2}->{$n1};
            $num_edges_have--;
        }
    }
    
    return( $g );
}


#========================
#      ** subgraphs **
#========================
#
# Strictly speaking a subgraph is (I think) just a subset of the edges and their
# associated nodes. Here I am working with the connected components of a graph,
# or connected subgraphs (csg) but can tend to call these subgraphs (which they 
# are - just not exclusively),.
#
# There are two "subgraph" functions here, one for determining the csg 
# containing a specified node, and one for deconstructing a graph into its
# component csgs'. In each case the resultant subgraph(s) could
# be represented by any one of: i) an array of the nodes, ii) a hash of the nodes,
# or iii) a graph proper. Here I work with (ii), returning a simple hash
# reference for the first function, and (a reference to) an array of hash 
# references for the second function. These hash lists can be converted into
# graphs proper using the third function below, "make_graph_from_csg_list".
 
sub get_csg_around_node
{
    my( $g, $n ) = @_;
    
    my( $node, $nbr );
    my $csg = { $n, 1 };
    my @sur = ( $n );      # the "surface" we build out to collect all the nodes
    
    while( 0 < @sur )
    {
        $node = pop @sur;
        foreach $nbr (keys %{$g->{$node}})
        {
            if( not exists $csg->{$nbr} )
            {
                $csg->{$nbr} = 1;
                push @sur, $nbr;
            }
        }
    }

    return( $csg );     # just a hash of the nodes. ie, NOT a graph
}


sub get_csg_all
{
    my( $g ) = @_;
    
    my( $csg, $n, $flag );
    my $ra_csg_all = [];

    foreach $n (keys %$g)
    {
        # is it in any of the csgs so far determined?
        $flag = 0;
        foreach $csg (@$ra_csg_all)
        {
            if( exists $csg->{$n} )
            {
                $flag = 1;
                last;
            }
        }
        if( 0 == $flag )
        {
            push @$ra_csg_all, get_csg_around_node( $g, $n );
        }
    }
    
    return( $ra_csg_all );
}


sub make_graph_from_csg_list
{
    my( $g, $csg ) = @_;
    
    my( $sg, $n1, $n2 );
    
    $sg = {};
    
    foreach $n1 (keys %$csg)
    {
        foreach $n2 (keys %{$g->{$n1}})
        {
            $sg->{$n1}->{$n2} = $g->{$n1}->{$n2};
        }
    }
    
    return( $sg );  # a graph proper
}


1;

